#!/usr/bin/perl -w
use strict;
use Getopt::Long qw(:config no_ignore_case);
my $opts={s=>" "};
my ($prog,$progdir);
# Who am I and how did I get here?
BEGIN {
  if($0 =~ m{(.*)/(.*?)$}) {
    ($progdir,$prog) = ($1,$2);
  } else {
    ($progdir,$prog) = ($0,'');
		$progdir = '.' unless $progdir;
		push @INC, "$progdir/lib", "$progdir";
	}
}

# Keep track of warnings, and put them at the bottom of any output
# to that they're not lost in the bunch of stuff that might scroll by.
my $warnings = "";

# What's this all about?
sub usage {
	$warnings = "\n$warnings" if $warnings;
<<"EOF"
======================================================================
$prog:
----------------------------------------------------------------------
Concatinates each line of file1 with each line of file2 separated by a
'string'.
----------------------------------------------------------------------
Usage: $prog [-s string] [-o out ] file1 file2
----------------------------------------------------------------------
file1  = file to put on the left-side of the line
file2  = file lines to put on the right side of the line
-s string = optional string to put in between (default is a single space
         " "). You can use '\\n', '\\t', '\\r', or '\\f', but know
         that the shell may probably change "-s \\t" to "-s t" and you
         will need to either specify -s \\\\t or -s '\\t'.
-o out = optional output file (default is STDOUT)
Examples:
# contactenate lines of file1 and file2 together separated by a tab, a
# pipe (|) and another tab
$prog -s "\\t|\\t" file1 file2
# interleave lines of file1 and file2
$prog -s "\\n" file1 file2
======================================================================$warnings
EOF
}

# Get the command-line options
GetOptions($opts,'s=s','o=s','help|h|?' )
  || die &usage, "ERROR: Did not understand command line options.\n";

# Check to see if we got some characters which maybe were supposed to be escaped.
if($opts->{s} =~ m{(?<!\\)([ntrf])}) {
	$warnings .= "WARNING: -s '$opts->{s}' contains a '$1'. Did you mean '\\$1'?\n";
}

# They need help
die &usage if $opts->{help};

# Unescape special chars
$opts->{s} =~ s{\\n}{\n}g;
$opts->{s} =~ s{\\t}{\t}g;
$opts->{s} =~ s{\\r}{\r}g;
$opts->{s} =~ s{\\f}{\f}g;

if(@ARGV != 2) {
	die &usage;
}

my (@file1,@file2);
foreach(@ARGV) {
	die &usage, "ERROR: $_ does not exists!\n" if(! -e $_);
	die &usage, "ERROR: $_ is not a file!\n" if(! -f $_);
	die &usage, "ERROR: $_ is not readable!\n" if(! -r $_);
}

my($file1,$file2) = (@ARGV);
open(IN,"< $file1") || die "ERROR: Unable to read '$file1'!REASON: $!\n";
chomp(@file1 = <IN>);
close(IN);

open(IN,"< $file2") || die "ERROR: Unable to read '$file2'!REASON: $!\n";
chomp(@file2 = <IN>);
close(IN);

if(@file1 != @file2) {
	$warnings .= "WARNING: $file1 has ".(@file1+0)." lines, while $file2 has ".(@file2+0)."! This may cause unexpeded results!\n";
}

open(OUT, ">&STDOUT");

if($opts->{o}) {
	my $out = $opts->{o};
	my $bak = "$out.bak";
	if(-e $out) {
		if(-e $bak) {
			$warnings .= "WARNING: Overwriting existing '$bak'!\n";
			unlink($bak) || die "ERROR: Unable to remove old backup '$bak'!\nREASON: $!\n";
		}
		rename($out,$bak) || die "ERROR: Unable to backup existing '$out' to '$bak'!\nREASON: $!\n";
	}
	open(OUT,">$out") || die "ERROR: Unable to open '$out' for writing!\nREASON: $!\n";
}

my @table;

while( @file1 || @file2) {
	chomp(my $line1 = @file1 ? shift(@file1) : '');
	chomp(my $line2 = @file2 ? shift(@file2) : '');
	print OUT $line1,$opts->{s},$line2,"\n";
}

close(OUT) if($opts->{o});

warn $warnings if $warnings;

exit;
__END__
